home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0769B.ZIP / BASCSTAT.PRG < prev    next >
Text File  |  1987-03-01  |  3KB  |  153 lines
  1. *:*********************************************************************
  2. *:
  3. *:      Program: BASCSTAT.PRG
  4. *:
  5. *:       System: Basic Statistics Compilation System
  6. *:       Author: Lee Correll
  7. *:    Copyright (c) 1987, Lee Correll
  8. *:
  9. *:        Calls: CHARACTER--procedure
  10. *:             : NUMERIC--procedure
  11. *:             : DISPLINE--procedure
  12. *:             : AVERAGE--procedure
  13. *:             : MODE1--procedure
  14. *:             : MEDIAN--procedure
  15. *:             : STDEV--procedure
  16. *:
  17. *:         Uses: STRUCTURE.DBF
  18. *:
  19. *: Documented: 3/1/87       1:00                   SNAP! version 1.72
  20. *:*********************************************************************
  21. CLEAR
  22. PUBLIC fn,nr,na,nb,nc,nd,ne,nf,high
  23. PUBLIC ft,avg,omde,medn,stddev
  24. PUBLIC valid
  25. SET STATUS OFF
  26. SET ECHO OFF
  27. SET EXACT ON
  28. SET TALK OFF
  29. SET CATALOG OFF
  30. SET SAFETY OFF
  31. SET PROCEDURE TO bascstat.xtr
  32. fn    = SPACE(15)
  33. fin   = SPACE(15)
  34. ft    = SPACE(10)
  35. high  = 0
  36. nr    = 0
  37. na    = 0
  38. nb    = 0
  39. nc    = 0 
  40. nd    = 0
  41. ne    = 0
  42. nf    = 0
  43. avg   = 0
  44. fin   = TRIM(UPPER(DBF()))
  45. ?"Copying Structure of "+fin+" to STRUCTURE.DBF"
  46. COPY STRUCTURE EXTENDED TO structure.dbf
  47. SELECT 2
  48. USE structure.dbf
  49. GO TOP
  50. SELECT 1 
  51. GO TOP
  52. SELECT 2
  53. DO WHILE .NOT. EOF()
  54.     IF RIGHT(TRIM(field_name),1) = "_" THEN
  55.         SKIP
  56.         LOOP
  57.     ENDIF
  58.     na = 0
  59.     nb = 0
  60.     nc = 0
  61.     nd = 0
  62.     ne = 0
  63.     nf = 0
  64.     ft = ""
  65.     ?
  66.     ?"Tabulating "+TRIM(field_name)
  67.     ?
  68.     DO CASE
  69.     CASE field_type = "C"
  70.         DO character
  71.         ft = "Character"
  72.     CASE field_type = "N"
  73.         DO numeric
  74.         ft = "Numeric"
  75.     OTHERWISE
  76.         LOOP
  77.     ENDCASE
  78.     RECS  = RECCOUNT()
  79.     valid = na + nb + nc + nd + ne + nf
  80.     invalid = RECS - valid
  81.     cumfreq = 0
  82.     ?"Printing"
  83.     SET DEVICE TO PRINT
  84.     @ 01,01 SAY "Filename  : "+fin           
  85.     @ 02,01 SAY "Fieldname : "+fn
  86.     @ 03,01 SAY "Fieldtype : "+ft
  87.     SELECT 1
  88.     SELECT 2
  89.     @ 08,01 SAY "                 Absolute   Relative    Adjusted    Cumulative"
  90.     @ 09,01 SAY "Response           Freq     Freq (%)    Freq (%)     Freq (%)"
  91.     
  92.     DO displine WITH 11,"Option 1",na,RECS,valid,cumfreq
  93.     
  94.     DO displine WITH 13,"Option 2",nb,RECS,valid,cumfreq
  95.     
  96.     nva = 15
  97.     
  98.     IF high >= 3 THEN
  99.         DO displine WITH nva,"Option 3",nc,RECS,valid,cumfreq
  100.         nva = 17
  101.     ENDIF
  102.     
  103.     IF high >= 4 THEN
  104.         DO displine WITH nva,"Option 4",nd,RECS,valid,cumfreq
  105.         nva = 19
  106.     ENDIF
  107.     
  108.     IF high >= 5 THEN
  109.         DO displine WITH nva,"Option 5",ne,RECS,valid,cumfreq
  110.         nva = 21
  111.     ENDIF
  112.     
  113.     IF high >= 6 THEN
  114.         DO displine WITH nva,"Option 6",nf,RECS,valid,cumfreq
  115.         nva = 23
  116.     ENDIF
  117.     
  118.     DO displine WITH nva,"Invalid Answer",invalid,RECS,valid,100
  119.     
  120.     @ nva+1,18 SAY "------"
  121.     @ nva+1,29 SAY "------"
  122.     @ nva+1,43 SAY "-------"
  123.     @ nva+2,01 SAY "Total:"
  124.     @ nva+2,19 SAY STR(RECS,3,0)
  125.     @ nva+2,31 SAY "100.0"
  126.     @ nva+2,43 SAY "100.0"
  127.     
  128.     @ nva+4,04 SAY "Valid Cases: "+STR(valid,3,0)+"     Invalid Cases: "+STR(invalid,3,0)
  129.     SET DEVICE TO SCREEN
  130.     ?"Calculating Advanced Statistical Functions"
  131.     SET DEVICE TO PRINT
  132.     DO AVERAGE   
  133.     @ nva+6,04 SAY "Average: "+STR(avg,5,3) 
  134.     DO mode1
  135.     @ nva+7,04 SAY "Mode   : "+STR(omde,1,0)
  136.     DO median
  137.     @ nva+8,04 SAY "Median : "+STR(medn,5,3)
  138.     DO stdev
  139.     @ nva+9,04 SAY "Std Dev: "+STR(stddev,10,8)
  140.     SET DEVICE TO SCREEN
  141.     SELECT 2
  142.     SKIP
  143.     
  144. ENDDO
  145. USE
  146. ERASE structure.dbf
  147. SELECT 1
  148. EJECT
  149. SET STATUS ON
  150. SET PROCEDURE TO 
  151. RETURN
  152. *: EOF: BASCSTAT.PRG
  153.